home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Visual Basic.60 / COMMON / TOOLS / VB / UNSUPPRT / IHANDLER / IHANDLER.CLS < prev    next >
Encoding:
Visual Basic class definition  |  1997-01-16  |  3.8 KB  |  83 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "cExtractIcon"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. '----------------------------------------------------------------
  13. '- Public Enums...
  14. '----------------------------------------------------------------
  15. Public Enum INPUTFLAGS
  16.     FOR_SHELL = GIL_FORSHELL
  17.     OPEN_ICON = GIL_OPENICON
  18. End Enum
  19.  
  20. Public Enum RETURNFLAGS
  21.     DONTCACHE = GIL_DONTCACHE
  22.     NOTFILENAME = GIL_NOTFILENAME
  23.     PERCLASS = GIL_PERCLASS
  24.     PERINSTANCE = GIL_PERINSTANCE
  25.     SIMULATEDOC = GIL_SIMULATEDOC
  26. End Enum
  27.  
  28. '----------------------------------------------------------------
  29. Public Sub GetIconLocation(clsid As String, iFlag As INPUTFLAGS, Idx As Long, IconFile As String, rFlags As RETURNFLAGS)
  30. '----------------------------------------------------------------
  31.     Dim ExIcon As IExtractIcon                          ' Object --> IExtractIcon Interface
  32.     Dim pUnk As IUnknown                                ' Object --> IUnknown Interface
  33.     Dim szIconFile As String                            ' Icon file path...
  34.     Dim cchMax As Long                                  ' Char count of icon file path
  35. '----------------------------------------------------------------
  36.     Set pUnk = CreateObjectLocal(clsid)                 ' Get IUnknown pointer to clsid object
  37.     Set ExIcon = pUnk                                   ' Implement Known Interface (IEctractIcon) from IUnknown...
  38.     
  39.     szIconFile = String(255, 0)                         ' Preallocate 255 null chars for string
  40.     cchMax = Len(szIconFile)                            ' Count length of string...
  41.     
  42.     ' Call GetIconLocation from clsid's IExtractIcon interface...
  43.     ExIcon.GetIconLocation iFlag, StrPtr(szIconFile), cchMax, Idx, rFlags
  44.     
  45.     IconFile = StrConv(szIconFile, vbUnicode)           ' Convert string to Unicode...
  46.     
  47.     Set ExIcon = Nothing                                ' Destroy IExtractIcon Interface reference
  48.     Set pUnk = Nothing                                  ' Destroy IUnknown Interface reference...
  49. '----------------------------------------------------------------
  50. End Sub
  51. '----------------------------------------------------------------
  52.  
  53. '----------------------------------------------------------------
  54. Public Function CreateObjectLocal(strCLS As String) As IUnknown
  55. '----------------------------------------------------------------
  56.     Dim rclsid As GUID                              ' Class identifier (CLSID) of object
  57.     Dim IID_IUnknown As GUID                        ' Reference to identifier of IUnknown interface
  58.     Dim pvObj As IUnknown                           ' Indirect pointer to requested interface
  59.     Dim hr As Long                                  ' HRESULT
  60. '----------------------------------------------------------------
  61.     hr = CLSIDFromString(ByVal StrPtr(strCLS), rclsid) ' Convert classid to guid
  62.     
  63.     If (hr = 0) Then                                ' If Success
  64.         With IID_IUnknown                           ' Build IUnknown Guid
  65.            .Data4(0) = &HC0
  66.            .Data4(7) = &H46
  67.         End With
  68.         
  69.         hr = CoCreateInstance(rclsid, ByVal 0&, CLSCTX_INPROC_SERVER, IID_IUnknown, pvObj) ' Get instance of object from classid
  70.         
  71.         If (hr = 0) Then                            ' If Success
  72.             Set CreateObjectLocal = pvObj           ' Return Created object
  73.             Exit Function
  74.         End If
  75.     End If
  76.     
  77.     If hr Then Err.Raise hr                         ' Validate HRESULT
  78. '----------------------------------------------------------------
  79. End Function
  80. '----------------------------------------------------------------
  81.  
  82.  
  83.